﻿Module TwoPhase
    Public Function PhaseOne(ByVal dt As DataTable) As Boolean
        Dim drZRow As DataRow = dt.NewRow
        drZRow.ItemArray = dt.Rows(0).ItemArray
        For Each dc As DataColumn In dt.Columns
            If dc.ColumnName = "Basic" Then
                Continue For
            ElseIf dc.ColumnName.Substring(0, 1) = "A" Then
                dt.Rows(0).Item(dc) = 1
            Else
                dt.Rows(0).Item(dc) = 0
            End If
        Next

        For Each dr As DataRow In dt.Rows
            If dr("Basic").subString(0, 1) = "A" Then
                For Each dc As DataColumn In dt.Columns
                    If dc.ColumnName = "Basic" OrElse dc.ColumnName = "Ratio" Then Continue For
                    dt.Rows(0).Item(dc) -= dr(dc)
                Next
            End If
        Next
        Dim PhaseOneComplete As Boolean = False
        Do Until PhaseOneComplete
            Dim FoundA As Boolean = False
            For Each dr As DataRow In ds.Tables(ds.Tables.Count - 1).Rows
                If dr("Basic").substring(0, 1) = "A" Then
                    FoundA = True
                    Exit For
                End If
            Next
            If FoundA Then
                nSteps += 1
                PhaseOneComplete = TwoPhase.Solve(ds.Tables(ds.Tables.Count - 1), True)
            Else
                Dim dtPhase2 As DataTable = ds.Tables(ds.Tables.Count - 1).Copy
                dtPhase2.TableName = "Phase 2"
                dtPhase2.Rows(0).ItemArray = drZRow.ItemArray
                For i As Integer = dtPhase2.Columns.Count - 1 To 0 Step -1
                    If dtPhase2.Columns(i).ColumnName.Substring(0, 1) = "A" Then
                        dtPhase2.Columns.RemoveAt(i)
                    End If
                Next
                ds.Tables.Add(dtPhase2)
                PhaseOneComplete = True
            End If
        Loop

        Return True
    End Function
    Public Function Solve(ByVal dt As DataTable, ByVal lPhase1 As Boolean) As Boolean
        Dim cEnteringVar As String = ""
        Dim nMostNegative As Decimal = 0
        Dim lPivot As Boolean = False
        Dim nMinRatio() As Decimal = {-1, 0}
        For Each dc As DataColumn In dt.Columns
            If dc.ColumnName = "Basic" OrElse dc.ColumnName = "RHS" OrElse dc.ColumnName = "Ratio" Then Continue For
            Dim nValue As Decimal = dt.Rows(0).Item(dc)
            If nValue < 0 AndAlso nValue < nMostNegative Then
                cEnteringVar = dc.ColumnName
                nMostNegative = nValue
                'Bland's rule takes the first negative, not the most.
            End If
        Next
        If nMostNegative = 0 And lPhase1 Then
            lInfeasible = True
            Return True
        ElseIf nMostNegative = 0 Then
            Return True
        Else
            nMinRatio = MinRatio(dt, cEnteringVar)
            If nMinRatio(0) >= 0 Then
                lPivot = Pivot(dt, cEnteringVar, CInt(nMinRatio(1)), lPhase1)
                Return False
            Else
                MessageBox.Show("The current problem is unbounded.")
                Return True
            End If
        End If



    End Function
    Public Function MinRatio(ByVal dt As DataTable, ByVal EnterVar As String) As Decimal()
        Dim nSmallestRatio As Decimal = -1
        Dim cLeavingVar As Integer = 0
        For i As Integer = 1 To dt.Rows.Count - 1
            Dim dr As DataRow = dt.Rows(i)
            If dr("RHS") < 0 Then
                Continue For
            ElseIf dr(EnterVar) <= 0 Then
                Continue For
            Else
                dr("Ratio") = dr("RHS") / dr(EnterVar)
                If dr("Ratio") >= 0 And (dr("Ratio") < nSmallestRatio OrElse nSmallestRatio < 0) Then
                    cLeavingVar = i
                    nSmallestRatio = dr("Ratio")
                End If
            End If
        Next

        Return {nSmallestRatio, CDec(cLeavingVar)}
    End Function
    Public Function Pivot(dtOld As DataTable, cEnteringVar As String, cLeavingVar As Integer, ByVal lPhase1 As Boolean) As Boolean
        Dim dt As DataTable = dtOld.Copy
        Dim lPivot As Boolean = False
        Dim BasicMult As Decimal = 1 / dt.Rows(cLeavingVar).Item(cEnteringVar)
        For Each dc As DataColumn In dt.Columns
            'If dc.ColumnName = "RHS" OrElse dc.ColumnName = "Ratio" Then
            'Continue For
            If dc.ColumnName = "Ratio" Then
                dt.Rows(cLeavingVar).Item(dc) = -1
            ElseIf dc.ColumnName = "Basic" Then
                dt.Rows(cLeavingVar).Item(dc) = cEnteringVar
            Else
                dt.Rows(cLeavingVar).Item(dc) *= BasicMult
            End If
        Next
        For i As Integer = 0 To dt.Rows.Count - 1
            If i = cLeavingVar Then Continue For
            Dim dr As DataRow = dt.Rows(i)
            Dim QuantityToAdd As Decimal = (-1 * dr(cEnteringVar) / dt.Rows(cLeavingVar).Item(cEnteringVar))
            For Each dc As DataColumn In dt.Columns
                If dc.ColumnName = "Basic" Then
                    Continue For
                ElseIf dc.ColumnName = "Ratio" Then
                    dr(dc) = -1
                Else
                    dr.Item(dc) = dr.Item(dc) + (QuantityToAdd * dt.Rows(cLeavingVar).Item(dc))
                End If
            Next
        Next
        dt.TableName = "Phase " & IIf(lPhase1, "1", "2") & " Step " & nSteps.ToString
        'dt.Columns.Remove("Ratio")
        FixDecimals(dt)
        ds.Tables.Add(dt)
        ds.AcceptChanges()
        Return True
    End Function
    Public Sub FixDecimals(ByRef dt As DataTable)
        For Each dc As DataColumn In dt.Columns
            If dc.DataType = GetType(Decimal) Then
                For Each dr As DataRow In dt.Rows
                    If dr(dc) <> 0 Then
                        dr(dc) = CDec(Math.Round(dr(dc), 3, MidpointRounding.ToEven).ToString.TrimEnd("0").TrimEnd("."))
                    Else
                        dr(dc) = CDec("0")
                    End If
                Next
            End If

        Next
    End Sub

End Module
